Mining Delphi's demo programs


	Community Home >Delphi> Programming

Mining Delphi's demo programs

Abstract:Precious nuggets of elegant code are to be found in the free source code on your Delphi CD. By Clay Shannon.

In the early days of Delphi (1995, to be exact, when Delphi 1.0 was known simply as Delphi), the worldÆs greatest software development tool shipped with a paltry 43 demo programs. There wasnÆt much recourse for us poor Delphi neophytes looking for guidance but to scour the Web and ask questions on the newsgroups.

Here in the latter part of 2001, the situation has improved dramatically. If we take a renewed look at the number of Borland-supplied Delphi demos, we see that upwards of 150 are included with Delphi 6. And many of them are far from trivial.

Delphi developers will benefit by going through these demo programs "with a knife and a flashlight," as Jeff Duntemann put it in Delphi Programming Explorer. Aspiring writers are told that in order to acquire a sense of what is good and what is bad regarding writing style and technique, they should read good writing: Read the classics, the best authors. The same holds true for writing good software. Read good source code! The demos that ship with Delphi provide a plethora of instructive examples, answers to FAQs, and elegant solutions to common coding problems.

As proof that there is gold in them thar hills, and to whet your appetite for prospecting there, I will now present a few of the gems I found on a recent expedition.

{ List all the fields in a dataset (from DBFilter) }
for I := 0 to DM1.CustomerSource.Dataset.FieldCount - 1 do
  ListBox1.Items.Add(DM1.Customer.Fields[I].FieldName);

{ "Home-made" primary key generator (from DBMastApp) }
with NextOrd do
  begin
    Open;
    try
      Edit;
      OrdersOrderNo.Value := NextOrdNewKey.Value;
      NextOrdNewKey.Value := NextOrdNewKey.Value + 1;
      Post;
    finally
      Close;
    end;
. . .

{ Map computer definitions and human definitions (from Docking) }
const
  Colors: array[0..6] of TColor = (clWhite, clBlue,  
    clGreen, clRed, clTeal, clPurple, clLime);
  ColStr: array[0..6] of string = ('White', 'Blue', 
    'Green', 'Red', 'Teal', 'Purple', 'Lime');

{ Sort a DBGrid (from MIDASAlchtest) }
procedure TDBClientTest.GridTitleClick(Column: TColumn);
var
  DataSet: TDataSet;
begin
  DataSet := Column.Field.DataSet;
  if DataSet is TClientDataSet then
    TClientDataSet(DataSet).IndexFieldNames :=  
      Column.Field.FieldName
  else if DataSet is TTable then
    begin
      if TTable(DataSet).IndexDefs.GetIndexForFields(
            Column.Field.FieldName, False) = nil then
        Exit;
      TTable(DataSet).IndexFieldNames :=  
        Column.Field.FieldName;
    end;
  StatusMsg := 'Sorted on '+Column.Field.FieldName;
end;

{ Example of owner draw in a grid (from MIDASMstrDtl) }
procedure TClientForm.MemberGridDrawColumnCell(Sender:    
  TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State:  
  TGridDrawState);
begin
  if DM.ProjectTEAM_LEADER.Value =
       DM.Emp_ProjEMP_NO.Value then
    MemberGrid.Canvas.Font.Style := [fsBold];
  MemberGrid.DefaultDrawColumnCell(
    Rect, DataCol, Column, State);
end;

{ Display the available fonts... }
procedure TForm1.FormCreate(Sender: TObject);
begin
  Listbox1.Items := Screen.Fonts;
end;

{ ...using the appropriate font... }
procedure TForm1.DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with ListBox1.Canvas do
  begin
    FillRect(Rect);
    Font.Name := ListBox1.Items[Index];
    Font.Size := 0;    // use font's preferred size
    TextOut(Rect.Left+1, Rect.Top+1,  
      ListBox1.Items[Index]);
  end;
end;

{ ...and size them correctly (from Ownerlst) }
procedure TForm1.ListBox1MeasureItem(Control: TWinControl;  
  Index: Integer; var Height: Integer);
begin
  with ListBox1.Canvas do
  begin
    Font.Name := Listbox1.Items[Index];
    Font.Size := 0;         // use font's preferred size
    Height := TextHeight('Wg') + 2; // measure ascenders  
                                    // and descenders
  end;
end;

{ Show total/available memory (from CoolStuff) }
var
  MS: TMemoryStatus;
begin
  GlobalMemoryStatus(MS);
  PhysMem.Caption := FormatFloat('#,###" KB"',  
    MS.dwTotalPhys / 1024);
  FreeRes.Caption := Format('%d %%', [MS.dwMemoryLoad]);
  . . .

{ If appropriate, allow user to select a Save option (from RichEdit) }
procedure TMainForm.CheckFileSave;
var
  SaveResp: Integer;
begin
  if not Editor.Modified then Exit;
  SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]),
    mtConfirmation, mbYesNoCancel, 0);
  case SaveResp of
    idYes: FileSave(Self);
    idNo: {Nothing};
    idCancel: Abort;
  end;
end;

{ File | Save code (from RichEdit)}
procedure TMainForm.FileSave(Sender: TObject);
begin
  if FFileName = sUntitled then
    FileSaveAs(Sender)
  else
  begin
    Editor.Lines.SaveToFile(FFileName);
    Editor.Modified := False;
    SetModified(False);
  end;
end;

{  File | Save As code (from RichEdit)}
procedure TMainForm.FileSaveAs(Sender: TObject);
begin
  if SaveDialog.Execute then
  begin
    if FileExists(SaveDialog.FileName) then
      if MessageDlg(Format(sOverWrite,  
          [SaveDialog.FileName]),
          mtConfirmation, mbYesNoCancel, 0) <> idYes then  
        Exit;
    Editor.Lines.SaveToFile(SaveDialog.FileName);
    SetFileName(SaveDialog.FileName);
    Editor.Modified := False;
    SetModified(False);
  end;
end;

{ Undo code (from RichEdit) }
procedure TMainForm.EditUndo(Sender: TObject);
begin
  with Editor do
    if HandleAllocated then SendMessage(
      Handle, EM_UNDO, 0, 0);
end;

{ Display cursor position in TMemo or TRichEdit in status bar (from RichEdit) }
procedure TMainForm.UpdateCursorPos;
var
  CharPos: TPoint;
begin
  CharPos.Y := SendMessage(
    Editor.Handle, EM_EXLINEFROMCHAR, 0,
    Editor.SelStart);
  CharPos.X := (Editor.SelStart -
    SendMessage(
      Editor.Handle, EM_LINEINDEX, CharPos.Y, 0));
  Inc(CharPos.Y);
  Inc(CharPos.X);
  StatusBar.Panels[0].Text :=
    Format(sColRowInfo, [CharPos.Y, CharPos.X]);
end;

{ Process virtual key codes (from VirtualListView) }
procedure TForm1.ListViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_RETURN:
      ListViewDblClick(Sender);
    VK_BACK:
      btnBackClick(Sender);  
  end;
end;

{ Alternate gridÆs background color (from WebServIIS) }
procedure TCustomerInfoModule.EmployeeListFormatCell(Sender: TObject;
  CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
  var Align: THTMLAlign; var VAlign: THTMLVAlign; var 
  CustomAttrs, CellData: String);
begin
  if CellRow = 0 then BgColor := 'Gray'
  else if CellRow mod 2 = 0 then BgColor := 'Silver';
end;

Maybe IÆm easily amused, but I got a thrill out of many of these snippets. And there are many other gems lying just below the surface in the demos. (Finding the remainder is an AELTTR, an exercise left to the reader.)

IÆve included here many of the useful bits that are applicable across most types of projects. The more specific and lower-level types of things (such as BinToHex conversions, streaming components, converting a .bmp to a .jpg, enumerating mapped drives, user-defined messages, callbacks, sort implementations, and so on) have not been included in this article. Depending on your particular area of interest, you will probably want to concentrate your focus on particular demos.

As Benjamin Franklin said, "An investment in knowledge always pays the best interest."

Clay Shannon doesnÆt know if he is a programmer who also happens to be a writer, or vice versa. He is the author of The Tomes of Delphi: DeveloperÆs Guide to Troubleshooting (Wordware 2001) and the novel Twisted Roads, which features a Delphi developer as one of the main characters. Clay has just finished his latest novel, entitled The Resurrection of Samuel Clemens, set in the year 2061. You can contact him at BClayShannon@aol.com.

Add or View comments on this article

NOTE: The views and information expressed in this document represent those of its author(s) who are solely responsible for its content. Borland does not make or give any representation or warranty with respect to such content.

Article ID: 27984 Publish Date: November 28, 2001 Last Modified: November 28, 2001